home *** CD-ROM | disk | FTP | other *** search
/ Delphi 2.0 - Programmer's Utilities Power Pack / Delphi 2.0 Programmer's Utilities Power Pack.iso / m_to_r / rptworks / demo1.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-09-15  |  11.1 KB  |  444 lines
  1. unit Demo1;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, Buttons, ExtCtrls, RptWorks, DBTables,
  8.   DB;
  9.  
  10. type
  11.   TForm1 = class(TForm)
  12.     Panel1: TPanel;
  13.     ScrollBox1: TScrollBox;
  14.     Button1: TButton;
  15.     Button2: TButton;
  16.     Button3: TButton;
  17.     Button4: TButton;
  18.     BitBtn1: TBitBtn;
  19.     BitBtn2: TBitBtn;
  20.     Label1: TLabel;
  21.     Bevel1: TBevel;
  22.     ReportWorks1: TReportWorks;
  23.     CustSource: TDataSource;
  24.     Cust: TTable;
  25.     CustCustNo: TFloatField;
  26.     CustCompany: TStringField;
  27.     CustAddr1: TStringField;
  28.     CustAddr2: TStringField;
  29.     CustCity: TStringField;
  30.     CustState: TStringField;
  31.     CustZip: TStringField;
  32.     CustPhone: TStringField;
  33.     OrderSource: TDataSource;
  34.     Orders: TTable;
  35.     OrdersOrderNo: TFloatField;
  36.     OrdersCustNo: TFloatField;
  37.     OrdersPaymentMethod: TStringField;
  38.     OrdersItemsTotal: TCurrencyField;
  39.     OrdersAmountPaid: TCurrencyField;
  40.     procedure FormResize(Sender: TObject);
  41.     procedure FormShow(Sender: TObject);
  42.     procedure Button3Click(Sender: TObject);
  43.     procedure Button2Click(Sender: TObject);
  44.     procedure Button4Click(Sender: TObject);
  45.     procedure Button1Click(Sender: TObject);
  46.     procedure BitBtn1Click(Sender: TObject);
  47.   private
  48.     { Private declarations }
  49.     function GetParagraph:pchar;
  50.     procedure PrintHeader;
  51.     procedure PrintReport;
  52.     procedure UpdatePageStatus;
  53.   public
  54.     { Public declarations }
  55.   end;
  56.  
  57. var
  58.   Form1: TForm1;
  59.   ABuffer:pchar;
  60.  
  61. implementation
  62.  
  63. {$R *.DFM}
  64.  
  65. procedure TForm1.FormResize(Sender: TObject);
  66. begin
  67.   {Make sure buttons appear in right position.}
  68.   if Width < 435 then Width := 435;
  69.   BitBtn1.Left := Panel1.Width - 181;
  70.   BitBtn2.Left := Panel1.Width - 85;
  71. end;
  72.  
  73. procedure TForm1.UpdatePageStatus;
  74. begin
  75.   {Update current report page.}
  76.   Label1.Caption := 'Page ' + IntToStr(ReportWorks1.CurrentPage)
  77.                     + ' of ' + IntToStr(ReportWorks1.PageTotal);
  78. end;
  79.  
  80. procedure TForm1.FormShow(Sender: TObject);
  81. begin
  82.   {Make sure buttons appear in right position.}
  83.   if Width < 435 then Width := 435;
  84.   BitBtn1.Left := Panel1.Width - 181;
  85.   BitBtn2.Left := Panel1.Width - 85;
  86.   {Set database range - don't need whole database for demo.}
  87.   Cust.SetRange([1221],[1510]);
  88.   {Print the report to the screen.}
  89.   PrintReport;
  90. end;
  91.  
  92. procedure TForm1.PrintReport;
  93. var ABitMap:TBitMap;
  94.     x:integer;
  95.     TotalMiles,TotalGas:integer;
  96.     shade:boolean;
  97.     tmpstr:string;
  98. begin
  99. {Get bitmap, if it exists.}
  100. try
  101. ABitMap := TBitMap.Create;
  102. ABitMap.LoadFromFile('c:\delphi\images\splash\16color\athena.bmp');
  103. except
  104. on Exception do ShowMessage('Athena bitmap not found!'); end;
  105. with ReportWorks1 do
  106.   begin
  107.   {Margins change later so make sure they are set
  108.    properly on future calls.}
  109.   LeftMargin := 1;
  110.   RightMargin := 1;
  111.   if Destination = dPreview then Screen.Cursor := crHourGlass;
  112.   StartDoc;
  113.   SetTab(1.25,jLeft);
  114.   { Use StectchGraphic instead of PositionGraphic as different
  115.     printer resolutions will affect size of bitmap with PositionGraphic. }
  116.   StretchGraphic(2.5,0,4,1.5,ABitMap);
  117.   for x := 1 to 8 do NextLine;
  118.   SetFont('Arial',14);
  119.   FontBold;
  120.   Print('Technical Report');
  121.   NextLine;
  122.   NextLine;
  123.   DrawLIne;
  124.   NextLine;
  125.   SetFont('Arial',10);
  126.   Print('To:');
  127.   PrintTab(1,'Delphi Programmer');
  128.   NextLine;
  129.   Print('From:');
  130.   PrintTab(1,'HSoftWare');
  131.   NextLine;
  132.   FontRegular;
  133.   Print('Product:');
  134.   PrintTab(1,'ReportWorks Component');
  135.   NextLine;
  136.   Print('Version:');
  137.   PrintTab(1,'1.00');
  138.   NextLine;
  139.   Print('Author:');
  140.   PrintTab(1,'Howard S. Walsh');
  141.   NextLine;
  142.   Print('Features:');
  143.   PrintTab(1,'Plenty');
  144.   NextLine;
  145.   Print('   Preview:');
  146.   PrintTab(1,'Yes');
  147.   NextLine;
  148.   Print('   Status Screen:');
  149.   PrintTab(1,'Yes');
  150.   NextLine;
  151.   Print('   Demo:');
  152.   PrintTab(1,'Yes');
  153.   NextLine;
  154.   Print('Date:');
  155.   PrintTab(1,DateToStr(Date));
  156.   NextLine;
  157.   FontBold;
  158.   Print('Subject:');
  159.   PrintTab(1,'Product Description');
  160.   NextLine;
  161.   NextLine;
  162.   FontRegular;
  163.   DrawLine;
  164.   NextLine;
  165.   NextLine;
  166.   PrintParagraph(GetParagraph);
  167.   {Report page 2}
  168.   NewPage;
  169.   ClearTabs;
  170.   LineWidth := lwDouble;
  171.   DrawLine;
  172.   NextLine;
  173.   SetFont('Arial',16);
  174.   PrintCenter('Car Expense Report');
  175.   NextLine;
  176.   NextLine;
  177.   SetFont('Arial',12);
  178.   FontItalic;
  179.   PrintLeft(DateToStr(Date));
  180.   NextLine;
  181.   LineWidth := lwNormal;
  182.   DrawLine;
  183.   SetTab(1.5,jLeft);
  184.   SetTab(4.5,jRight);
  185.   SetTab(6.5,jRight);
  186.   NextLine;
  187.   FontRegular;
  188.   FontBold;
  189.   Print('Date');
  190.   PrintTab(1,'Description');
  191.   PrintTab(2,'Mileage');
  192.   PrintTab(3,'Gas');
  193.   FontRegular;
  194.   NextLine;
  195.   TotalMiles := 0;
  196.   TotalGas := 0;
  197.   for x := 0 to 25 do
  198.      begin
  199.      Print(DateToStr(Date + x));
  200.      PrintTab(1,'Business Trip');
  201.      PrintTab(2,IntToStr(x * 15));
  202.      PrintTab(3,IntToStr(x * 8) + '.00');
  203.      TotalMiles := TotalMiles + (x*15);
  204.      TotalGas := TotalGas + (x * 8);
  205.      NextLine;
  206.      end;
  207.   NextLine;
  208.   FontBold;
  209.   PrintTab(2,IntToStr(TotalMiles));
  210.   PrintTab(3,IntToStr(TotalGas) + '.00');
  211.   FontRegular;
  212.   GoToPageBottom;
  213.   DrawLine;
  214.   {Report page 3}
  215.   NewPage;
  216.   ClearTabs;
  217.   ShadeLine(clRed);
  218.   DrawLine;
  219.   NextLine;
  220.   ShadeLine(clRed);
  221.   NextLine;
  222.   ShadeLine(clRed);
  223.   PreviousLine;
  224.   PreviousLine;
  225.   SetFont('Arial',16);
  226.   PrintCenter('ReportWorks Sales Report');
  227.   NextLine;
  228.   NextLine;
  229.   SetFont('Arial',12);
  230.   PrintRight(DateToStr(Date));
  231.   NextLine;
  232.   DrawLine;
  233.   SetTab(1.25,jLeft);
  234.   SetTab(3,jCenter);
  235.   SetTab(4.5,jRight);
  236.   SetTab(6.5,jRight);
  237.   FontBold;
  238.   Print('Date');
  239.   PrintTab(1,'Software');
  240.   PrintTab(2,'Sold');
  241.   PrintTab(3,'Unit');
  242.   PrintTab(4,'Price');
  243.   FontRegular;
  244.   NextLine;
  245.   shade := true;
  246.   for x := 1 to 35 do
  247.      begin
  248.      if shade then ShadeLine(clYellow);
  249.      shade := not shade;
  250.      Print(DateToStr(Date + x));
  251.      PrintTab(1,'ReportWorks');
  252.      PrintTab(2,IntToStr(x));
  253.      PrintTab(3,'29.00');
  254.      { This is just faster (easier) }
  255.      PrintTab(4,IntToStr(x*29) + '.00');
  256.      NextLine;
  257.      end;
  258.   while not IsPageEnd do
  259.      begin
  260.      if shade then ShadeLine(clYellow);
  261.      shade := not shade;
  262.      NextLine;
  263.      end;
  264.   {Report page 4 - MAST database demo.}
  265.   NewPage;
  266.   ClearTabs;
  267.   LeftMargin := 0.5;
  268.   RightMargin := 0.5;
  269.   GoToPageTop;
  270.   {Tabs for company info.}
  271.   SetTab(0.4,jLeft);
  272.   SetTab(3.5,jLeft);
  273.   SetTab(5.1,jLeft);
  274.   SetTab(6.0,jLeft);
  275.   SetTab(7.5,jRight);
  276.   {Tabs for order info.}
  277.   SetTab(1,jLeft);
  278.   SetTab(2,jLeft);
  279.   SetTab(4.8,jRight);
  280.   SetTab(6.0,jRight);
  281.   {Make sure we are on the first record.}
  282.   Cust.First;
  283.   PrintHeader;
  284.   while not Cust.EOF do
  285.      begin
  286.      {Shade two lines.}
  287.      ShadeLine(clBlue);
  288.      NextLine;
  289.      ShadeLine(clBlue);
  290.      PreviousLine;
  291.      {FontColor is a new procedure - undocumented in current version.}
  292.      FontColor(clYellow);
  293.      SetFont('Arial',8);
  294.      Print(CustCustNo.AsString);
  295.      SetFont('Arial',14);
  296.      PrintTab(1,CustCompany.Value);
  297.      SetFont('Arial',10);
  298.      PrintTab(2,CustAddr1.Value);
  299.      PrintTab(3,CustCity.Value);
  300.      PrintTab(4,CustState.Value);
  301.      PrintTab(5,CustPhone.Value + '  ');
  302.      NextLine;
  303.      SetFont('Arial',8);
  304.      FontItalic;
  305.      PrintTab(6,'Order No.');
  306.      PrintTab(7,'Payment Method');
  307.      PrintTab(8,'Total');
  308.      PrintTab(9,'Amount Paid');
  309.      NextLine;
  310.      FontRegular;
  311.      SetFont('Arial',10);
  312.      if IsPageEnd then
  313.         begin
  314.         NewPage;
  315.         PrintHeader;
  316.         end;
  317.      while not Orders.EOF do
  318.         begin
  319.         FontColor(clBlack);
  320.         PrintTab(6,IntToStr(round(OrdersOrderNo.Value)));
  321.         PrintTab(7,OrdersPaymentMethod.Value);
  322.         Str(OrdersItemsTotal.Value:8:2,tmpstr);
  323.         PrintTab(8,tmpstr);
  324.         Str(OrdersAmountPaid.Value:8:2,tmpstr);
  325.         PrintTab(9,tmpstr);
  326.         NextLine;
  327.         if IsPageEnd then
  328.           begin
  329.           NewPage;
  330.           PrintHeader;
  331.           end;
  332.         Orders.Next;
  333.         end;
  334.      NextLine;
  335.      Cust.Next;
  336.      end;
  337.   EndDoc;
  338.   Screen.Cursor := crDefault;
  339.   end;
  340. ABitMap.Free;
  341. UpdatePageStatus;
  342. end;
  343.  
  344. procedure TForm1.PrintHeader;
  345. {Header for MAST database report.}
  346. begin
  347.   with ReportWorks1 do
  348.      begin
  349.      FontBold;
  350.      FontColor(clBlue);
  351.      SetFont('Times Roman',42);
  352.      Print('MAST');
  353.      SetFont('Arial',16);
  354.      NextLine;
  355.      PrintRight('Marine Adventure Sales Report');
  356.      NextLine;
  357.      NextLine;
  358.      ShadeLine(clBlue);
  359.      FontColor(clYellow);
  360.      SetFont('Arial',10);
  361.      Print(' ReportWorks for Delphi Sample Report');
  362.      FontItalic;
  363.      PrintRight(DateToStr(Date)+'  ');
  364.      FontColor(clBlack);
  365.      FontRegular;
  366.      NextLine;
  367.      NextLine;
  368.      end;
  369. end;
  370.  
  371.  
  372. function TForm1.GetParagraph:pchar;
  373. {Buffer to show PrintParagraph - could use memo database field.}
  374. const ABuf1:pchar = 'The ReportWorks component is designed to provide fast,';
  375.       ABuf2:pchar = ' simple, hasslefree reporting functionality. Reports can';
  376.       ABuf3:pchar = ' be previewed, printed to the printer or printed to file.';
  377.       ABuf4:pchar = ' Columns can be established in the form of tabs with left,';
  378.       ABuf5:pchar = ' right and center justification.  Lines, or rows, can be';
  379.       ABuf6:pchar = ' shaded, if so desired.' + #10 + #13 + #13;
  380.       ABuf7:pchar = 'Output can be printed with or without linefeed, left,';
  381.       ABuf8:pchar = ' right or center justified. Large strings, longer than';
  382.       ABuf9:pchar = ' 255 characters, can be output with automatic word-wrap';
  383.       ABuf10:pchar = ' within the established page margins.' + #13 + #13 + #10;
  384.       ABuf11:pchar = 'Printer page units can be set to Inches, Millimeters or';
  385.       ABuf12:pchar = ' Points. Once margins are set, all printing occurs';
  386.       ABuf13:pchar = ' within these boundaries.' + #13 + #13 + #10;
  387.       ABuf14:pchar = 'Graphics functionality is available, and bitmaps, icons';
  388.       ABuf15:pchar = ' and metafiles can be imported to the page.' + #13 + #13 + #10;
  389.       ABuf16:pchar = 'See following pages for additional report styles.';
  390. begin
  391. GetMem(ABuffer,5000);
  392. StrCopy(ABuffer, ABuf1);
  393. StrCat(ABuffer, ABuf2);
  394. StrCat(ABuffer, ABuf3);
  395. StrCat(ABuffer, ABuf4);
  396. StrCat(ABuffer, ABuf5);
  397. StrCat(ABuffer, ABuf6);
  398. StrCat(ABuffer, ABuf7);
  399. StrCat(ABuffer, ABuf8);
  400. StrCat(ABuffer, ABuf9);
  401. StrCat(ABuffer, ABuf10);
  402. StrCat(ABuffer, ABuf11);
  403. StrCat(ABuffer, ABuf12);
  404. StrCat(ABuffer, ABuf13);
  405. StrCat(ABuffer, ABuf14);
  406. StrCat(ABuffer, ABuf15);
  407. StrCat(ABuffer, ABuf16);
  408. Result := ABuffer;
  409. end;
  410.  
  411. procedure TForm1.Button3Click(Sender: TObject);
  412. begin
  413.   ReportWorks1.NextPage;
  414.   PrintReport;
  415. end;
  416.  
  417. procedure TForm1.Button2Click(Sender: TObject);
  418. begin
  419.   ReportWorks1.PreviousPage;
  420.   PrintReport
  421. end;
  422.  
  423. procedure TForm1.Button4Click(Sender: TObject);
  424. begin
  425.   ReportWorks1.LastPage;
  426.   PrintReport;
  427. end;
  428.  
  429. procedure TForm1.Button1Click(Sender: TObject);
  430. begin
  431.   ReportWorks1.FirstPage;
  432.   PrintReport;
  433. end;
  434.  
  435. procedure TForm1.BitBtn1Click(Sender: TObject);
  436. {Change destination to the printer, print report and reset destination.}
  437. begin
  438.   ReportWorks1.Destination := dPrinter;
  439.   PrintReport;
  440.   ReportWorks1.Destination := dPreview;
  441. end;
  442.  
  443. end.
  444.